home *** CD-ROM | disk | FTP | other *** search
/ PC World Komputer 2010 April / PCWorld0410.iso / hity wydania / Ubuntu 9.10 PL / karmelkowy-koliberek-desktop-9.10-i386-PL.iso / casper / filesystem.squashfs / usr / bin / make_method < prev    next >
Text File  |  2008-11-04  |  19KB  |  593 lines
  1. #!/usr/bin/perl
  2.  
  3. eval 'exec /usr/bin/perl  -S $0 ${1+"$@"}'
  4.     if 0; # not running under some shell
  5. ###############################################################################
  6. #
  7. # This file copyright (c) 2001-2008 Randy J. Ray, all rights reserved
  8. # $Id: make_method 343 2008-04-09 09:54:36Z rjray $
  9. #
  10. # See "LICENSE" in the documentation for licensing and redistribution terms.
  11. #
  12. ###############################################################################
  13. #
  14. #   $Id: make_method 343 2008-04-09 09:54:36Z rjray $
  15. #
  16. #   Description:    Simple tool to turn a Perl routine and the support data
  17. #                   into the simple XML representation that RPC::XML::Server
  18. #                   understands.
  19. #
  20. #   Functions:      write_file
  21. #
  22. #   Libraries:      Config
  23. #                   Getopt::Long
  24. #                   IO::File
  25. #                   File::Spec
  26. #
  27. #   Global Consts:  $VERSION
  28. #                   $cmd
  29. #
  30. #   Environment:    None.
  31. #
  32. ###############################################################################
  33.  
  34. use 5.005;
  35. use strict;
  36. use vars qw($cmd $USAGE $VERSION $revision %opts $ifh $ofh $path
  37.             $helptxt $codetxt @siglist $name $type $version $hidden $lang);
  38. use subs qw(read_external write_file);
  39.  
  40. use Config;
  41. use Getopt::Long;
  42. use IO::File;
  43. use File::Spec;
  44.  
  45. $VERSION = '1.12';
  46. ($cmd = $0) =~ s|.*/||;
  47. $USAGE = "$cmd [ --options ]
  48.  
  49. Where:
  50.  
  51. --help        Generate this message.
  52.  
  53. --name        Specifies the external (published) name of the method.
  54. --type        Specify whether this defines a PROCEDURE, a METHOD or a
  55.                 FUNCTION (case-free)
  56. --version     Gives the version that should be attached to the method.
  57. --hidden      Takes no value; if passed, flags the method as hidden.
  58. --signature   Specifies one method signature. May be specified more than once.
  59. --helptext    Provides the help string.
  60. --helpfile    Gives the name of a file from which the help-text is read.
  61. --code        Gives the name of the file from which to read the code.
  62. --output      Name of the file to write the resulting XML to.
  63.  
  64. --base        If passed, this is used as a base-name from which to derive all
  65.               the other information. The file <base>.base must exist and be
  66.               readable. That file will provide the information for the method,
  67.               some of which may point to other files to be read. When done, the
  68.               output is written to <base>.xpl.
  69.  
  70.               If --base is specified, all other options are ignored, and any
  71.               missing information (such as no signatures, etc.) will cause an
  72.               error.
  73. ";
  74.  
  75. GetOptions(\%opts,
  76.            qw(help
  77.               base=s
  78.               name=s type=s version=s hidden signature=s@ helptext=s
  79.               helpfile=s code=s
  80.               output=s))
  81.     or die "$USAGE\n\nStopped";
  82.  
  83. if ($opts{help})
  84. {
  85.     print $USAGE;
  86.     exit;
  87. }
  88.  
  89. #
  90. # First we start by getting all our data. Once that's all in place, then the
  91. # generation of the file is simple.
  92. #
  93. if ($opts{base})
  94. {
  95.     # This simplifies a lot of it
  96.  
  97.     (undef, $path, $name) = File::Spec->splitpath($opts{base});
  98.     $path = '.' unless $path;
  99.     $type = 'm'; # Default the type to 'm'ethod.
  100.     $codetxt = {};
  101.  
  102.     $ifh = new IO::File "< $opts{base}.base";
  103.     die "Error opening $opts{base}.base for reading: $!\nStopped"
  104.         unless ($ifh);
  105.     while (defined($_ = <$ifh>))
  106.     {
  107.         chomp;
  108.  
  109.         if (/^name:\s+([\w\.]+)$/i)
  110.         {
  111.             $name = $1;
  112.         }
  113.         elsif (/^type:\s+(\S+)$/i)
  114.         {
  115.             $type = substr(lc $1, 0, 1);
  116.         }
  117.         elsif (/^version:\s+(\S+)$/i)
  118.         {
  119.             $version = $1;
  120.         }
  121.         elsif (/^signature:\s+\b(.*)$/i)
  122.         {
  123.             push(@siglist, $1);
  124.         }
  125.         elsif (/^hidden:\s+(no|yes)/i)
  126.         {
  127.             $hidden = ($1 eq 'yes') ? 1 : 0;
  128.         }
  129.         elsif (/^helpfile:\s+(.*)/i)
  130.         {
  131.             $helptxt = read_external(File::Spec->catfile($path, $1));
  132.         }
  133.         elsif (/^codefile(\[(.*)\])?:\s+(.*)/i)
  134.         {
  135.             $lang = $2 || 'perl';
  136.             $codetxt->{$lang} = read_external(File::Spec->catfile($path, $3));
  137.         }
  138.     }
  139.     die "Error: no code specified in $opts{base}.base, stopped"
  140.         unless (keys %$codetxt);
  141.     die "Error: no signatures found in $opts{base}.base, stopped"
  142.         unless (@siglist);
  143.  
  144.     $ofh = new IO::File "> $opts{base}.xpl";
  145.     die "Error opening $opts{base}.xpl for writing: $!\nStopped"
  146.         unless ($ofh);
  147. }
  148. else
  149. {
  150.     if ($opts{name})
  151.     {
  152.         $name = $opts{name};
  153.     }
  154.     else
  155.     {
  156.         die 'No name was specified for the published routine, stopped';
  157.     }
  158.  
  159.     $type =    $opts{type}    || 'm';
  160.     $hidden =  $opts{hidden}  || 0;
  161.     $version = $opts{version} || '';
  162.  
  163.     if ($opts{signature})
  164.     {
  165.         @siglist = map { s/:/ /g; $_ } @{$opts{signature}};
  166.     }
  167.     else
  168.     {
  169.         die "At least one signature must be specified for $name, stopped";
  170.     }
  171.  
  172.     if ($opts{helptext})
  173.     {
  174.         $$helptxt = "$opts{helptext}\n";
  175.     }
  176.     elsif ($opts{helpfile})
  177.     {
  178.         $helptxt = read_external($opts{helpfile});
  179.     }
  180.     else
  181.     {
  182.         $$helptxt = '';
  183.     }
  184.  
  185.     if ($opts{code})
  186.     {
  187.         $codetxt->{perl} = read_external($opts{code});
  188.     }
  189.     else
  190.     {
  191.         $codetxt->{perl} = join('', <STDIN>);
  192.     }
  193.  
  194.     if ($opts{output})
  195.     {
  196.         $ofh = new IO::File "> $opts{output}";
  197.         die "Unable to open $opts{output} for writing: $!\nStopped"
  198.             unless ($ofh);
  199.     }
  200.     else
  201.     {
  202.         $ofh = \*STDOUT;
  203.     }
  204. }
  205.  
  206. write_file($ofh,
  207.            $name, $type, $version, $hidden, $codetxt, $helptxt, \@siglist);
  208.  
  209. exit;
  210.  
  211. ###############################################################################
  212. #
  213. #   Sub Name:       read_external
  214. #
  215. #   Description:    Simple snippet to read in an external file and return the
  216. #                   results as a ref-to-scalar
  217. #
  218. #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  219. #                   $file     in      scalar    File to open and read
  220. #
  221. #   Globals:        None.
  222. #
  223. #   Environment:    None.
  224. #
  225. #   Returns:        Success:    scalar ref
  226. #                   Failure:    dies
  227. #
  228. ###############################################################################
  229. sub read_external
  230. {
  231.     my $file = shift;
  232.  
  233.     my $fh = new IO::File "< $file";
  234.     die "Cannot open file $file for reading: $!, stopped" unless ($fh);
  235.  
  236.     my $tmp = join('', <$fh>);
  237.     \$tmp;
  238. }
  239.  
  240. ###############################################################################
  241. #
  242. #   Sub Name:       write_file
  243. #
  244. #   Description:    Write the XML file that will describe a publishable method
  245. #
  246. #   Arguments:      NAME      IN/OUT  TYPE      DESCRIPTION
  247. #                   $fh       in      IO        Filehandle to write to
  248. #                   $name     in      scalar    Name (external) of method
  249. #                   $type     in      scalar    Identifies outer tag to use
  250. #                   $version  in      scalar    Version string (if any)
  251. #                   $hidden   in      scalar    Boolean whether to hide it
  252. #                   $code     in      sc ref    Actual Perl code
  253. #                   $help     in      sc ref    Help text for the method
  254. #                   $sigs     in      listref   List of one or more signatures
  255. #                                                 for the method
  256. #
  257. #   Globals:        $cmd
  258. #                   $VERSION
  259. #
  260. #   Environment:    None.
  261. #
  262. #   Returns:        void
  263. #
  264. ###############################################################################
  265. sub write_file
  266. {
  267.     my ($fh, $name, $type, $version, $hidden, $code, $help, $sigs) = @_;
  268.  
  269.     my $date = scalar localtime;
  270.     my %typemap = ( 'm' => 'method',
  271.                     p   => 'procedure',
  272.                     f   => 'function');
  273.     my $tag  = "$typemap{$type}def";
  274.  
  275.     # Armor against XML confusion
  276.     foreach ($name, $$help)
  277.     {
  278.         s/&/&/g;
  279.         s/</</g;
  280.         s/>/>/g;
  281.     }
  282.     for (keys %$code)
  283.     {
  284.         if (($_ eq 'perl') and (index(${$code->{$_}}, ']]>') == -1) and
  285.             (index(${$code->{$_}}, '__END__') == -1))
  286.         {
  287.             ${$code->{$_}} =
  288.                 "<![CDATA[\n$Config{startperl}\n${$code->{$_}}\n__END__\n]]>";
  289.         }
  290.         else
  291.         {
  292.             ${$code->{$_}} =~ s/&/&/g;
  293.             ${$code->{$_}} =~ s/</</g;
  294.             ${$code->{$_}} =~ s/>/>/g;
  295.         }
  296.     }
  297.  
  298.     print $ofh <<"EO_HDR";
  299. <?xml version="1.0" encoding="iso-8859-1"?>
  300. <!DOCTYPE $tag SYSTEM "rpc-method.dtd">
  301. <!--
  302.     Generated automatically by $cmd v$VERSION, $date
  303.  
  304.     Any changes made here will be lost.
  305. -->
  306. <$tag>
  307. EO_HDR
  308.  
  309.     print $ofh "<name>$name</name>\n";
  310.     print $ofh "<version>$version</version>\n" if $version;
  311.     print $ofh "<hidden />\n" if $hidden;
  312.     print $ofh map { "<signature>$_</signature>\n" } @$sigs;
  313.     print $ofh "<help>\n$$help</help>\n" if ($$help);
  314.     for (sort keys %$code)
  315.     {
  316.         print $ofh qq{<code language="perl">\n$ {$code->{$_}}</code>\n};
  317.     }
  318.  
  319.     print $ofh "</$tag>\n";
  320.  
  321.     return;
  322. }
  323.  
  324. __END__
  325.  
  326. =head1 NAME
  327.  
  328. make_method - Turn Perl code into an XML description for RPC::XML::Server
  329.  
  330. =head1 SYNOPSIS
  331.  
  332.     make_method --name=system.identification --helptext='System ID string'
  333.         --signature=string --code=ident.pl --output=ident.xpl
  334.  
  335.     make_method --base=methods/identification
  336.  
  337. =head1 DESCRIPTION
  338.  
  339. This is a simple tool to create the XML descriptive files for specifying
  340. methods to be published by an B<RPC::XML::Server>-based server.
  341.  
  342. If a server is written such that the methods it exports (or I<publishes>) are
  343. a part of the running code, then there is no need for this tool. However, in
  344. cases where the server may be separate and distinct from the code (such as an
  345. Apache-based RPC server), specifying the routines and filling in the
  346. supporting information can be cumbersome.
  347.  
  348. One solution that the B<RPC::XML::Server> package offers is the means to load
  349. publishable code from an external file. The file is in a simple XML dialect
  350. that clearly delinates the externally-visible name, the method signatures, the
  351. help text and the code itself. These files may be created manually, or this
  352. tool may be used as an aide.
  353.  
  354. =head1 OPTIONS
  355.  
  356. The tool recognizes the following options:
  357.  
  358. =over 4
  359.  
  360. =item --help
  361.  
  362. Prints a short summary of the options.
  363.  
  364. =item --name=STRING
  365.  
  366. Specifies the published name of the method being encoded. This is the name by
  367. which it will be visible to clients of the server.
  368.  
  369. =item --type=STRING
  370.  
  371. Specify the type for the resulting file. "Type" here refers to whether the
  372. container tag used in the resulting XML will specify a B<procedure> or a
  373. B<method>. The default is B<method>. The string is treated case-independant,
  374. and only the first character (C<m> or C<p>) is actually regarded.
  375.  
  376. =item --version=STRING
  377.  
  378. Specify a version stamp for the code routine.
  379.  
  380. =item --hidden
  381.  
  382. If this is passe, the resulting file will include a tag that tells the server
  383. daemon to not make the routine visible through any introspection interfaces.
  384.  
  385. =item --signature=STRING [ --signature=STRING ... ]
  386.  
  387. Specify one or more signatures for the method. Signatures should be the type
  388. names as laid out in the documentation in L<RPC::XML>, with the elements
  389. separated by a colon. You may also separate them with spaces, if you quote the
  390. argument. This option may be specified more than once, as some methods may
  391. have several signatures.
  392.  
  393. =item --helptext=STRING
  394.  
  395. Specify the help text for the method as a simple string on the command line.
  396. Not suited for terribly long help strings.
  397.  
  398. =item --helpfile=FILE
  399.  
  400. Read the help text for the method from the file specified.
  401.  
  402. =item --code=FILE
  403.  
  404. Read the actual code for the routine from the file specifed. If this option is
  405. not given, the code is read from the standard input file descriptor.
  406.  
  407. =item --output=FILE
  408.  
  409. Write the resulting XML representation to the specified file. If this option
  410. is not given, then the output goes to the standard output file descriptor.
  411.  
  412. =item --base=NAME
  413.  
  414. This is a special, "all-in-one" option. If passed, all other options are
  415. ignored.
  416.  
  417. The value is used as the base element for reading information from a file
  418. named B<BASE>.base. This file will contain specification of the name, version,
  419. hidden status, signatures and other method information. Each line of the file
  420. should look like one of the following:
  421.  
  422. =over 4
  423.  
  424. =item B<Name: I<STRING>>
  425.  
  426. Specify the name of the routine being published. If this line does not appear,
  427. then the value of the B<--base> argument with all directory elements removed
  428. will be used.
  429.  
  430. =item B<Version: I<STRING>>
  431.  
  432. Provide a version stamp for the function. If no line matching this pattern is
  433. present, no version tag will be written.
  434.  
  435. =item B<Hidden: I<STRING>>
  436.  
  437. If present, I<STRING> should be either C<yes> or C<no> (case not important).
  438. If it is C<yes>, then the method is marked to be hidden from any introspection
  439. API.
  440.  
  441. =item B<Signature: I<STRING>>
  442.  
  443. This line may appear more than once, and is treated cumulatively. Other
  444. options override previous values if they appear more than once. The portion
  445. following the C<Signature:> part is taken to be a published signature for the
  446. method, with elements separated by whitespace. Each method must have at least
  447. one signature, so a lack of any will cause an error.
  448.  
  449. =item B<Helpfile: I<STRING>>
  450.  
  451. Specifies the file from which to read the help text. It is not an error if
  452. no help text is specified.
  453.  
  454. =item B<Codefile: I<STRING>>
  455.  
  456. Specifies the file from which to read the code. Code is assumed to be Perl,
  457. and will be tagged as such in the resulting file.
  458.  
  459. =item B<Codefile[lang]: I<string>>
  460.  
  461. Specifies the file from which to read code, while also identifying the
  462. language that the code is in. This allows for the creation of a B<XPL> file
  463. that includes multiple language implementations of the given method or
  464. procedure.
  465.  
  466. =back
  467.  
  468. Any other lines than the above patterns are ignored.
  469.  
  470. If no code has been read, then the tool will exit with an error message.
  471.  
  472. The output is written to B<BASE>.xpl, preserving the path information so that
  473. the resulting file is right alongside the source files. This allows constructs
  474. such as:
  475.  
  476.     make_method --base=methods/introspection
  477.  
  478. =back
  479.  
  480. =head1 FILE FORMAT AND DTD
  481.  
  482. The file format for these published routines is a very simple XML dialect.
  483. This is less due to XML being an ideal format than it is the availability of
  484. the parser, given that the B<RPC::XML::Server> class will already have the
  485. parser code in core. Writing a completely new format would not have gained
  486. anything.
  487.  
  488. The Document Type Declaration for the format can be summarized by:
  489.  
  490.     <!ELEMENT  proceduredef (name, version?, hidden?, signature+,
  491.                              help?, code)>
  492.     <!ELEMENT  methoddef  (name, version?, hidden?, signature+,
  493.                            help?, code)>
  494.     <!ELEMENT  functiondef (name, version?, hidden?, signature+,
  495.                             help?, code)>
  496.     <!ELEMENT  name       (#PCDATA)>
  497.     <!ELEMENT  version    (#PCDATA)>
  498.     <!ELEMENT  hidden     EMPTY>
  499.     <!ELEMENT  signature  (#PCDATA)>
  500.     <!ELEMENT  help       (#PCDATA)>
  501.     <!ELEMENT  code       (#PCDATA)>
  502.     <!ATTLIST  code       language (#PCDATA)>
  503.  
  504. The file C<rpc-method.dtd> that comes with the distribution has some
  505. commentary in addition to the actual specification.
  506.  
  507. A file is (for now) limited to one definition. This is started by the one of
  508. the opening tags C<E<lt>methoddefE<gt>>, C<E<lt>functiondefE<gt>> or
  509. C<E<lt>proceduredefE<gt>>. This is followed by exactly one C<E<lt>nameE<gt>>
  510. container specifying the method name, an optional version stamp, an optional
  511. hide-from-introspection flag, one or more C<E<lt>signatureE<gt>> containers
  512. specifying signatures, an optional C<E<lt>helpE<gt>> container with the help
  513. text, then the C<E<lt>codeE<gt>> container with the actual program code. All
  514. text should use entity encoding for the symbols:
  515.  
  516.     & C<&> (ampersand)
  517.     E<lt> C<<>  (less-than)
  518.     E<gt> C<>>  (greater-than)
  519.  
  520. The parsing process within the server class will decode the entities. To make
  521. things easier, the tool scans all text elements and encodes the above entities
  522. before writing the file.
  523.  
  524. =head2 The Specification of Code
  525.  
  526. This is not I<"Programming 101">, nor is it I<"Perl for the Somewhat Dim">.
  527. The code that is passed in via one of the C<*.xpl> files gets passed to
  528. C<eval> with next to no modification (see below). Thus, badly-written or
  529. malicious code can very well wreak havoc on your server. This is not the fault
  530. of the server code. The price of the flexibility this system offers is the
  531. responsibility on the part of the developer to ensure that the code is tested
  532. and safe.
  533.  
  534. Code itself is treated as verbatim as possible. Some edits may occur on the
  535. server-side, as it make the code suitable for creating an anonymous subroutine
  536. from. The B<make_method> tool will attempt to use a C<CDATA> section to embed
  537. the code within the XML document, so that there is no need to encode entities
  538. or such. This allows for the resulting F<*.xpl> files to be syntax-testable
  539. with C<perl -cx>. You can aid this by ensuring that the code does not contain
  540. either of the two following character sequences:
  541.  
  542.     ]]>
  543.  
  544.     __DATA__
  545.  
  546. The first is the C<CDATA> terminator. If it occurs naturally in the code, it
  547. would trigger the end-of-section in the parser. The second is the familiar
  548. Perl token, which is inserted so that the remainder of the XML document does
  549. not clutter up the Perl parser.
  550.  
  551. =head1 EXAMPLES
  552.  
  553. The B<RPC::XML> distribution comes with a number of default methods in a
  554. subdirectory called (cryptically enough) C<methods>. Each of these is
  555. expressed as a set of (C<*.base>, C<*.code>, C<*.help>) files. The Makefile.PL
  556. file configures the resulting Makefile such that these are used to create
  557. C<*.xpl> files using this tool, and then install them.
  558.  
  559. =head1 DIAGNOSTICS
  560.  
  561. Most problems come out in the form of error messages followed by an abrupt
  562. exit.
  563.  
  564. =head1 CAVEATS
  565.  
  566. I don't much like this approach to specifying the methods, but I liked my
  567. other ideas even less.
  568.  
  569. =head1 CREDITS
  570.  
  571. The B<XML-RPC> standard is Copyright (c) 1998-2001, UserLand Software, Inc.
  572. See <http://www.xmlrpc.com> for more information about the B<XML-RPC>
  573. specification.
  574.  
  575. =head1 LICENSE
  576.  
  577. This module and the code within are released under the terms of the Artistic
  578. License 2.0
  579. (http://www.opensource.org/licenses/artistic-license-2.0.php). This code may
  580. be redistributed under either the Artistic License or the GNU Lesser General
  581. Public License (LGPL) version 2.1
  582. (http://www.opensource.org/licenses/lgpl-license.php).
  583.  
  584. =head1 SEE ALSO
  585.  
  586. L<RPC::XML>, L<RPC::XML::Server>
  587.  
  588. =head1 AUTHOR
  589.  
  590. Randy J. Ray <rjray@blackperl.com>
  591.  
  592. =cut
  593.